home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 7 / Amiga Format AFCD07 (Dec 1996, Issue 91).iso / serious / shareware / programming / emacs-complete / fsf / emacs / lisp / rlogin.el < prev    next >
Lisp/Scheme  |  1994-06-15  |  6KB  |  164 lines
  1. ;;; rlogin.el --- remote login interface
  2.  
  3. ;; Author: Noah Friedman
  4. ;; Maintainer: Noah Friedman <friedman@prep.ai.mit.edu>
  5. ;; Keywords: unix, comm
  6.  
  7. ;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
  8. ;;
  9. ;; This program is free software; you can redistribute it and/or modify
  10. ;; it under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation; either version 2, or (at your option)
  12. ;; any later version.
  13. ;;
  14. ;; This program is distributed in the hope that it will be useful,
  15. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17. ;; GNU General Public License for more details.
  18. ;;
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with this program; if not, write to: The Free Software Foundation,
  21. ;; Inc.; 675 Massachusetts Avenue.; Cambridge, MA 02139, USA.
  22.  
  23. ;;; Commentary:
  24.  
  25. ;; Support for remote logins using `rlogin'.
  26. ;; $Id: rlogin.el,v 1.18 1994/06/16 08:09:34 friedman Exp $
  27.  
  28. ;; If you wish for rlogin mode to prompt you in the minibuffer for
  29. ;; passwords when a password prompt appears, just enter m-x send-invisible
  30. ;; and type in your line, or add `comint-watch-for-password-prompt' to
  31. ;; `comint-output-filter-functions'.
  32.  
  33. ;;; Code:
  34.  
  35. (require 'comint)
  36. (require 'shell)
  37.  
  38. ;;;###autoload
  39. (defvar rlogin-program "rlogin"
  40.   "*Name of program to invoke rlogin")
  41.  
  42. ;;;###autoload
  43. (defvar rlogin-explicit-args nil
  44.   "*List of arguments to pass to rlogin on the command line.")
  45.  
  46. ;;;###autoload
  47. (defvar rlogin-mode-hook nil
  48.   "*Hooks to run after setting current buffer to rlogin-mode.")
  49.  
  50. ;;;###autoload
  51. (defvar rlogin-process-connection-type nil
  52.   "*If non-`nil', use a pty for the local rlogin process.  
  53. If `nil', use a pipe (if pipes are supported on the local system).  
  54.  
  55. Generally it is better not to waste ptys on systems which have a static
  56. number of them.  On the other hand, some implementations of `rlogin' assume
  57. a pty is being used, and errors will result from using a pipe instead.")
  58.  
  59. ;;;###autoload
  60. (defvar rlogin-initially-track-cwd t
  61.   "*If non-`nil', do remote directory tracking via ange-ftp right away.
  62. If `nil', you can still enable directory tracking by doing 
  63. `M-x dirtrack-toggle'.")
  64.  
  65. ;; Initialize rlogin mode map.
  66. (defvar rlogin-mode-map '())
  67. (cond ((not rlogin-mode-map)
  68.        (setq rlogin-mode-map (cons 'keymap shell-mode-map)) 
  69.        (define-key rlogin-mode-map "\C-c\C-c" 'rlogin-send-Ctrl-C)
  70.        (define-key rlogin-mode-map "\C-c\C-d" 'rlogin-send-Ctrl-D)
  71.        (define-key rlogin-mode-map "\C-c\C-z" 'rlogin-send-Ctrl-Z)
  72.        (define-key rlogin-mode-map "\C-c\C-\\" 'rlogin-send-Ctrl-backslash)
  73.        (define-key rlogin-mode-map "\C-d" 'rlogin-delchar-or-send-Ctrl-D)))
  74.  
  75. ;;;###autoload
  76. (defun rlogin (input-args &optional prefix)
  77.   "Open a network login connection to HOST via the `rlogin' program.
  78. Input is sent line-at-a-time to the remote connection.
  79.  
  80. Communication with the remote host is recorded in a buffer *rlogin-HOST*,
  81. where HOST is the first word in the string ARGS.  If a prefix argument is
  82. given and the buffer *rlogin-HOST* already exists, a new buffer with a
  83. different connection will be made.
  84.  
  85. The variable `rlogin-program' contains the name of the actual program to
  86. run.  It can be a relative or absolute path. 
  87.  
  88. The variable `rlogin-explicit-args' is a list of arguments to give to
  89. the rlogin when starting.  They are added after any arguments given in ARGS."
  90.   (interactive (list (read-from-minibuffer "rlogin arguments (hostname first): ")
  91.                      current-prefix-arg))
  92.   (let* ((process-connection-type rlogin-process-connection-type)
  93.          (buffer-name (format "*rlogin-%s*" input-args))
  94.          args
  95.      proc
  96.          (old-match-data (match-data)))
  97.     (while (string-match "[ \t]*\\([^ \t]+\\)$" input-args)
  98.       (setq args 
  99.             (cons (substring input-args (match-beginning 1) (match-end 1))
  100.                   args)
  101.             input-args (substring input-args 0 (match-beginning 0))))
  102.     (store-match-data old-match-data)
  103.     (setq buffer-name (format "*rlogin-%s*" (car args))
  104.           args (append args rlogin-explicit-args))
  105.     (and prefix (setq buffer-name 
  106.                       (buffer-name (generate-new-buffer buffer-name))))
  107.     (switch-to-buffer buffer-name)
  108.     (or (comint-check-proc buffer-name)
  109.         (progn
  110.           (comint-mode)
  111.           (comint-exec (current-buffer) buffer-name rlogin-program nil args)
  112.           (setq proc (get-process buffer-name))
  113.           ;; Set process-mark to point-max in case there is text in the
  114.           ;; buffer from a previous exited process.
  115.           (set-marker (process-mark proc) (point-max))
  116.           (rlogin-mode)
  117.           ;; Set the prefix for filename completion and directory tracking
  118.           ;; to find the remote machine's files by ftp.
  119.           (setq comint-file-name-prefix (concat "/" (car args) ":"))
  120.           (and rlogin-initially-track-cwd
  121.                ;; Presume the user will start in his remote home directory.
  122.                ;; If this is wrong, M-x dirs will fix it.
  123.                (cd-absolute (concat "/" (car args) ":~/")))))))
  124.  
  125. (defun rlogin-mode ()
  126.   "Set major-mode for rlogin sessions. 
  127. If `rlogin-mode-hook' is set, run it."
  128.   (interactive)
  129.   (kill-all-local-variables)
  130.   (shell-mode)
  131.   (setq major-mode 'rlogin-mode)
  132.   (setq mode-name "rlogin")
  133.   (use-local-map rlogin-mode-map)
  134.   (setq shell-dirtrackp rlogin-initially-track-cwd)
  135.   (make-local-variable 'comint-file-name-prefix)
  136.   (run-hooks 'rlogin-mode-hook))
  137.  
  138.  
  139. (defun rlogin-send-Ctrl-C ()
  140.   (interactive)
  141.   (send-string nil "\C-c"))
  142.  
  143. (defun rlogin-send-Ctrl-D ()
  144.   (interactive)
  145.   (send-string nil "\C-d"))
  146.  
  147. (defun rlogin-send-Ctrl-Z ()
  148.   (interactive)
  149.   (send-string nil "\C-z"))
  150.  
  151. (defun rlogin-send-Ctrl-backslash ()
  152.   (interactive)
  153.   (send-string nil "\C-\\"))
  154.  
  155. (defun rlogin-delchar-or-send-Ctrl-D (arg)
  156.   "\
  157. Delete ARG characters forward, or send a C-d to process if at end of buffer."  
  158.   (interactive "p") 
  159.   (if (eobp)
  160.       (rlogin-send-Ctrl-D)
  161.     (delete-char arg)))
  162.  
  163. ;;; rlogin.el ends here
  164.